home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbauth.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-12-01  |  12.6 KB  |  361 lines
  1. (*===========================================================================*)
  2. (* Authentication tasks                                                      *)
  3. (*                                                                           *)
  4. (*   Copyright 1991 by H. Roy Engehausen.  All rights reserved.              *)
  5. (*   This software may be freely distributed and used, but it may not        *)
  6. (*   under any circumstances be sold by anyone other than the author.        *)
  7. (*   It may be distributed by a commercial company as long as it is          *)
  8. (*   for no cost.                                                            *)
  9. (*                                                                           *)
  10. (*===========================================================================*)
  11.  
  12. {$UNDEF  DEBUG_PASS}
  13. {$UNDEF  DEBUG_FILE} (* Debug checking the file for a password *)
  14.  
  15. {$O+}
  16.  
  17. UNIT BBAUTH;
  18.  
  19. INTERFACE
  20.  
  21. PROCEDURE user_auth(work_1 : STRING);
  22.  
  23. IMPLEMENTATION
  24.  
  25.   USES
  26.     CRT,
  27.     DOS,
  28.     bbdummy,
  29.     bbmdata,
  30.     bbmess,
  31.     bbmisc,
  32.     bbmisc5,
  33.     bbrdata,
  34.     bbsdata,
  35.     bbstr,
  36.     match;
  37.  
  38. PROCEDURE user_auth(work_1 : STRING);
  39.  
  40.   CONST
  41.     no_of_no = 5; (* Number of letters in the challenge *)
  42.  
  43.   VAR
  44.     b          : BOOLEAN;
  45.     i          : INTEGER;
  46.     j          : BYTE;
  47.     k          : BYTE;
  48.     num_list   : ARRAY[1..no_of_no] OF BYTE;
  49.     pw_file    : TEXT;
  50.     pw_ok      : BOOLEAN;
  51.     work_2     : STRING[8];
  52.  
  53.   LABEL
  54.     iterate_i, loop_iterate, loop_leave;
  55.  
  56.   BEGIN;
  57.  
  58.     (*-----------------------------------------------------------------------*)
  59.     (* See if the password file exists.  If not, we can't authenticate       *)
  60.     (*-----------------------------------------------------------------------*)
  61.  
  62.     IF opt_block.passwd_fn = '' THEN
  63.       BEGIN;
  64.         send_tnc_data_str('No password file specified' + cr);
  65.         active_tcb^.error_sw         := TRUE;
  66.         active_tcb^.tcb_error_reason := 255; (* Suppress message *)
  67.         EXIT;
  68.       END;
  69.  
  70.     (*-----------------------------------------------------------------------*)
  71.     (* Open file for input and handle errors                                 *)
  72.     (*-----------------------------------------------------------------------*)
  73.  
  74.     ASSIGN(pw_file, opt_block.passwd_fn);
  75.  
  76.     {$I-}
  77.     RESET(pw_file);
  78.     {$I+}
  79.  
  80.     i := IORESULT;
  81.  
  82.     IF i <> 0 THEN
  83.       BEGIN;
  84.         send_tnc_data_str('Cannot open password file' + cr);
  85.         send_tnc_data_str(dos_err_message(i) + cr);
  86.         active_tcb^.error_sw         := TRUE;
  87.         active_tcb^.tcb_error_reason := 255; (* Suppress message *)
  88.         EXIT;
  89.       END;
  90.  
  91.     (*-----------------------------------------------------------------------*)
  92.     (* Loop here looking for the right line in the file                      *)
  93.     (*-----------------------------------------------------------------------*)
  94.  
  95. loop_iterate:
  96.  
  97.     (*-----------------------------------------------------------------------*)
  98.     (* If we have reached the end then leave with a blank line               *)
  99.     (*-----------------------------------------------------------------------*)
  100.  
  101.     IF EOF(pw_file) THEN
  102.       BEGIN;
  103.         work_1 := '';
  104.         GOTO loop_leave;
  105.       END;
  106.  
  107.     (*-----------------------------------------------------------------------*)
  108.     (* Read a line from the file                                             *)
  109.     (*-----------------------------------------------------------------------*)
  110.  
  111.     READLN(pw_file, work_1);
  112.  
  113.     (*-----------------------------------------------------------------------*)
  114.     (* Parse the link and ignore comments                                    *)
  115.     (*-----------------------------------------------------------------------*)
  116.  
  117.     upcase_str_var(work_1);
  118.     strip_var(work_1, 'B');
  119.  
  120.     IF (work_1 = '') OR (work_1[1] = ';') OR (WORDS(work_1) < 2) THEN
  121.       GOTO loop_iterate;
  122.  
  123.     (*-----------------------------------------------------------------------*)
  124.     (* Get userid                                                            *)
  125.     (*-----------------------------------------------------------------------*)
  126.  
  127.     work_2 := subword(@work_1, 1, 1);
  128.  
  129.     (*-----------------------------------------------------------------------*)
  130.     (* See if this is the right user.  If not, try next line                 *)
  131.     (*-----------------------------------------------------------------------*)
  132.  
  133.     {$IFDEF DEBUG_FILE}
  134.       WRITELN('Test -- ', active_tcb^.uid_data.user_id, '/', work_2,
  135.               ' -- ', match_str(active_tcb^.uid_data.user_id, work_2));
  136.     {$ENDIF}
  137.  
  138.     IF NOT match_str(active_tcb^.uid_data.user_id, work_2) THEN
  139.       GOTO loop_iterate;
  140.  
  141.     (*-----------------------------------------------------------------------*)
  142.     (* Get the password.  We skip the userid and get the rest.  Don't use    *)
  143.     (* subword because of multiple blank suppression                         *)
  144.     (*-----------------------------------------------------------------------*)
  145.  
  146.     i := 1;
  147.  
  148.     WHILE work_1[i] <> ' ' DO
  149.      INC(i);
  150.  
  151.     REPEAT
  152.       INC(i);
  153.     UNTIL work_1[i] <> ' ';
  154.  
  155.     work_1 := COPY(work_1, i, 255);
  156.  
  157.     {$IFDEF DEBUG_FILE}
  158.       WRITELN('pw = ', LENGTH(work_1), ' -- "', work_1, '"');
  159.     {$ENDIF}
  160.  
  161.     (*-----------------------------------------------------------------------*)
  162.     (* Come here when we have either found the right line or ran off the     *)
  163.     (* end of the file                                                       *)
  164.     (*-----------------------------------------------------------------------*)
  165.  
  166. loop_leave:
  167.  
  168.     (*-----------------------------------------------------------------------*)
  169.     (* Close the file                                                        *)
  170.     (*-----------------------------------------------------------------------*)
  171.  
  172.     CLOSE(pw_file);
  173.  
  174.     (*-----------------------------------------------------------------------*)
  175.     (* If we didn't find the user then we are sick                           *)
  176.     (*-----------------------------------------------------------------------*)
  177.  
  178.     IF work_1 = '' THEN
  179.       BEGIN;
  180.         send_tnc_data_str('Password file does not contain record for user '
  181.                           + active_tcb^.uid_data.user_id
  182.                           + cr);
  183.         active_tcb^.error_sw         := TRUE;
  184.         active_tcb^.tcb_error_reason := 255; (* Suppress message *)
  185.         EXIT;
  186.       END;
  187.  
  188.     (*-----------------------------------------------------------------------*)
  189.     (* Passowrd is too short                                                 *)
  190.     (*-----------------------------------------------------------------------*)
  191.  
  192.     IF LENGTH(work_1) < (no_of_no + 2) THEN
  193.       BEGIN;
  194.         send_tnc_data_str('Password is too short for user '
  195.                           + active_tcb^.uid_data.user_id
  196.                           + cr);
  197.         active_tcb^.error_sw         := TRUE;
  198.         active_tcb^.tcb_error_reason := 255; (* Suppress message *)
  199.         EXIT;
  200.       END;
  201.  
  202.     (*-----------------------------------------------------------------------*)
  203.     (* Get ready to match the password                                       *)
  204.     (*-----------------------------------------------------------------------*)
  205.  
  206.     pw_ok := FALSE;
  207.  
  208.     (*-----------------------------------------------------------------------*)
  209.     (* Loop until user is done                                               *)
  210.     (*-----------------------------------------------------------------------*)
  211.  
  212.     REPEAT
  213.  
  214.       (*---------------------------------------------------------------------*)
  215.       (* Send the first part of the message                                  *)
  216.       (*---------------------------------------------------------------------*)
  217.  
  218.       send_tnc_data_str(get_message(message_enter_password) + ' --');
  219.  
  220.       (*---------------------------------------------------------------------*)
  221.       (* Get the numbers                                                     *)
  222.       (*---------------------------------------------------------------------*)
  223.  
  224.       i := 1;
  225.       REPEAT
  226.  
  227.         (*-------------------------------------------------------------------*)
  228.         (* Make sure we don't point to a blank                               *)
  229.         (*-------------------------------------------------------------------*)
  230.  
  231.         REPEAT
  232.           j := RANDOM(LENGTH(work_1)) + 1;
  233.         UNTIL work_1[j] <> ' ';
  234.  
  235.         (*-------------------------------------------------------------------*)
  236.         (* Make sure we don't have a duplicate                               *)
  237.         (*-------------------------------------------------------------------*)
  238.  
  239.         FOR k := 1 TO i-1 DO
  240.           IF j = num_list[k] THEN
  241.             GOTO iterate_i;
  242.  
  243.         (*-------------------------------------------------------------------*)
  244.         (* OK.. Got a number.  Store it away                                 *)
  245.         (*-------------------------------------------------------------------*)
  246.  
  247.         num_list[i] := j;
  248.  
  249.         INC(i);
  250.  
  251.         (*-------------------------------------------------------------------*)
  252.         (* Come here to repeat the loop                                      *)
  253.         (*-------------------------------------------------------------------*)
  254.  
  255. iterate_i:
  256.  
  257.       UNTIL i > no_of_no;
  258.  
  259.       (*---------------------------------------------------------------------*)
  260.       (* Sort the numbers into ascending order                               *)
  261.       (*---------------------------------------------------------------------*)
  262.  
  263.       i := 1;
  264.       REPEAT
  265.         IF num_list[i] > num_list[i+1] THEN
  266.           BEGIN;
  267.  
  268.             j             := num_list[i];
  269.             num_list[i]   := num_list[i+1];
  270.             num_list[i+1] := j;
  271.  
  272.             i := 0;
  273.           END;
  274.         INC(i);
  275.       UNTIL i = no_of_no;
  276.  
  277.       (*---------------------------------------------------------------------*)
  278.       (* Put the numbers in character format and send to user                *)
  279.       (*---------------------------------------------------------------------*)
  280.  
  281.       FOR i := 1 TO no_of_no DO
  282.         BEGIN;
  283.           STR(num_list[i], work_2);
  284.           send_tnc_data_str(' ' + work_2);
  285.         END;
  286.  
  287.       send_tnc_data_str(cr);
  288.  
  289.       (*---------------------------------------------------------------------*)
  290.       (* Get response                                                        *)
  291.       (*---------------------------------------------------------------------*)
  292.  
  293.       REPEAT
  294.  
  295.         work_2 := read_tnc_data_str;
  296.  
  297.         strip_crlf(work_2);
  298.         upcase_str_var(work_2);
  299.  
  300.         IF work_2 = '?' THEN
  301.           IF pw_ok THEN
  302.             send_message(message_auth_complete)
  303.           ELSE
  304.             send_message(message_auth_incomplete);
  305.  
  306.       UNTIL work_2 <> '?';
  307.  
  308.       {$IFDEF DEBUG_PASS}
  309.         WRITELN('Passin=', LENGTH(work_2), '=', work_2);
  310.       {$ENDIF}
  311.  
  312.       (*---------------------------------------------------------------------*)
  313.       (* Test the response                                                   *)
  314.       (*---------------------------------------------------------------------*)
  315.  
  316.       b := FALSE;
  317.  
  318.       IF LENGTH(work_2) = no_of_no THEN
  319.         BEGIN;
  320.  
  321.           b := TRUE;
  322.  
  323.           FOR i := 1 TO no_of_no DO
  324.             BEGIN;
  325.               b := b AND (work_2[i] = work_1[num_list[i]]);
  326.               {$IFDEF DEBUG_PASS}
  327.                 WRITELN('B = ', b, ' -- i = ', i,
  328.                                    ' -- ', work_2[i],
  329.                                    ' -- ', num_list[i], work_1[num_list[i]]);
  330.               {$ENDIF}
  331.             END;
  332.  
  333.         END;
  334.  
  335.       {$IFDEF DEBUG_PASS}
  336.         WRITELN('B = ', b, ' -- ok = ', pw_ok);
  337.       {$ENDIF}
  338.  
  339.       (*---------------------------------------------------------------------*)
  340.       (* If this was good then turn on password switch                       *)
  341.       (*---------------------------------------------------------------------*)
  342.  
  343.       IF b THEN
  344.         pw_ok := TRUE;
  345.  
  346.     UNTIL work_2 = ''; (*---- Loop until user sends blank line --------------*)
  347.  
  348.     (*-----------------------------------------------------------------------*)
  349.     (* See the error switch accordingly                                      *)
  350.     (*-----------------------------------------------------------------------*)
  351.  
  352.     IF pw_ok THEN
  353.       EXIT;
  354.  
  355.     active_tcb^.error_sw         := TRUE;
  356.     active_tcb^.tcb_error_reason := 1; (* Authentication failed *)
  357.  
  358.   END;
  359.  
  360. END.
  361.